home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / v7n11.arc / CAR.BAS < prev    next >
BASIC Source File  |  1988-05-02  |  3KB  |  105 lines
  1. 'CAR.BAS by Brian Giedt
  2.  
  3. DEFINT A-Z
  4. SCREEN 1, 0
  5.  
  6. PI! = 4! * ATN(1!)
  7. DIM A(200), B(200)
  8. DIM RoadLine(3), R(500), S!
  9.  
  10. CIRCLE (4, 4), 2, 3             'draw wheel
  11. CIRCLE (4, 4), 1, 3             'draw spokes inside wheel
  12. GET (1, 1)-(6, 6), B            'capture wheel and put into B array
  13. PUT (1, 1), B, XOR              'erases it from the screen
  14.  
  15. LINE (21, 30)-(28, 30), 3: LINE (34, 30)-(38, 30), 3      'draw car outline
  16. LINE -(36, 25), 3: LINE -(33, 25), 3: LINE -(33, 23), 3
  17. LINE -(24, 23), 3: LINE -(20, 25), 3: LINE -(11, 27), 3
  18. LINE -(10, 30), 3: LINE -(15, 30), 3
  19. CIRCLE (18, 31), 4, 3, 0, PI!   'wheel hubs
  20. CIRCLE (31, 31), 4, 3, 0, PI!
  21.  
  22. PAINT (25, 25), 2, 3            'paint the car body red
  23. LINE (25, 25)-(29, 26), 1, BF   'paint the window cyan
  24.  
  25. PUT (15, 28), B, XOR            'place wheels on the car
  26. PUT (28, 28), B, XOR
  27. GET (10, 22)-(38, 33), A        'capture first image of the car
  28.  
  29. PUT (15, 28), B, XOR            'remove wheels
  30. PUT (28, 28), B, XOR
  31. PUT (15, 29), B, XOR            'place the wheels one line below the position
  32. PUT (28, 29), B, XOR            ' used before
  33. GET (10, 23)-(38, 34), B        'capture second image of the car at one
  34.                                 '  pixel below where it was capture before
  35.                                 ' this provides the bouncing effect, while
  36.                                 ' the wheels always stay on the ground
  37.  
  38. PUT (10, 23), B, XOR            'erase extra image from the screen
  39.  
  40. LINE (12, 80)-(0, 116)          'capture a line at the angle of the road
  41. GET (0, 80)-(12, 116), R
  42.  
  43. LINE (6, 94)-(319, 94)          'draw road
  44. LINE (0, 130)-(319, 130)
  45. 'PAINT (319, 100), 1, 3         'optional to paint road white
  46. RoadLine(1) = 30
  47. RoadLine(2) = 130
  48. RoadLine(3) = 230
  49. FOR I = 1 TO 3                  'place lines across the road
  50.    PUT (RoadLine(I), 94), R, XOR
  51. NEXT
  52.  
  53. LINE (0, 80)-(12, 80), 2        'draw brick wall at the end of the road
  54. LINE (12, 80)-(12, 94), 2
  55. LINE (12, 94)-(0, 130), 2
  56. PAINT (0, 113), 2, 2
  57. LINE (12, 80)-(0, 116), 0
  58.  
  59. T = 280
  60. S! = 0
  61. I = 1
  62.  
  63. WHILE T                 'while car is still on the road
  64.  
  65.    PUT (T, 100), A, XOR 'place first image of the car
  66.      CALL Roadlines(I)  'move one of the roadlines
  67.      CALL Pause         'pause briefly
  68.      CALL Roadlines(I)  'move another roadline
  69.    PUT (T, 100), A, XOR 'remove first image of the car
  70.                         'notice nothing is done while the image is off screen
  71.    PUT (T, 100), B, XOR 'place second car image (car is raised above ground)
  72.      CALL Roadlines(I)  'move one more of the roadlines
  73.      CALL Pause         'pause again
  74.      CALL Roadlines(I)  'move another roadline
  75.    PUT (T, 100), B, XOR 'remove second image of car
  76.  
  77.    T = T - S!     'minimal calculations done while image is off the screen
  78.    S! = S! + .1   'accelerate
  79.  
  80. WEND
  81.  
  82. PUT (T + S!, 100), B, XOR   'put image back on screen to show crash into wall
  83.  
  84. FOR T = 100 TO 50 STEP -1   'crash noise
  85.     SOUND T, .2
  86.     SOUND 32767, .1
  87. NEXT
  88. END
  89.  
  90. SUB Pause STATIC
  91.    HoldTime! = TIMER
  92.    WHILE TIMER < HoldTime! + .01
  93.    WEND
  94. END SUB
  95.  
  96. SUB Roadlines (I) STATIC
  97.     SHARED RoadLine(), R(), S!
  98.     PUT (RoadLine(I), 94), R, XOR
  99.     RoadLine(I) = RoadLine(I) + S!
  100.     IF RoadLine(I) > 305 THEN RoadLine(I) = 5
  101.     PUT (RoadLine(I), 94), R, XOR
  102.     I = (I MOD 3) + 1            'increments I from 1 to 3 inclusively
  103.     SOUND 100 + (S! * 8), .2
  104. END SUB
  105.